home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / wcl-21.lha / wcl-2.1 / src / build / kcl.lsp < prev    next >
Lisp/Scheme  |  1992-09-10  |  1KB  |  54 lines
  1. ;;; (C) Copyright 1990-1992 by Wade L. Hennessey. All rights reserved.
  2.  
  3. ;;; HEY! I doubt that builds with kcl work anymore...
  4.  
  5. (in-package "W")
  6.  
  7.  
  8. (setf *default-pathname-defaults* ".lisp")
  9. (proclaim '(optimize (speed 0) (safety 3) (compilation-speed 3) (space 0))))
  10.  
  11. ;(format t "~%********Growing stacks*************~%")
  12. (setf si::*multiply-stacks* 2) 
  13.  
  14. (in-package "W")
  15.  
  16. (defmacro select (key-form &rest cases)
  17.   (let ((key (gensym "KEY")))
  18.     `(let ((,key ,key-form))
  19.       (cond ,@(loop for (case . consequent) in cases
  20.             collect (cons (if (member case '(t otherwise))
  21.                       t
  22.                       (if (atom case)
  23.                       `(eql ,key ,case)
  24.                       `(member ,key (list ,@case))))
  25.                   consequent))))))
  26.  
  27.  
  28. (progn (defun shell (cmd)
  29.      (if  (> (length cmd) 1023)
  30.           (progn
  31.         (warn "Cmd too long for losing KCL SYSTEM function")
  32.         (warn "Executing via a shell script")
  33.         (with-open-file (out "kcl-tmp" :direction :output)
  34.           (write-string cmd out)))
  35.         (system "kcl-tmp")
  36.           (system cmd)))
  37.        (setf *print-circle* t)
  38.        (defmacro destructuring-bind (l form &body body)
  39.      `(destructure (,l ,form) ,@body)))
  40.         
  41. ;;; (setf compiler::*cc* "echo SKIP CC ")
  42.  
  43. (in-package "USER")
  44.  
  45. (defun w ()
  46.   (load "system-builder")
  47.   (load "make")
  48.   (in-package "W"))
  49.  
  50. (setf si:*notify-gbc* t)
  51. (allocate 'cons 1500 t)
  52. (allocate 'string 300 t)
  53.  
  54.